lab02
2026-02-23
Read csv
data <- read.csv("movies_2026.csv", stringsAsFactors = FALSE)1.1
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
# Excluímos id, textos, y variables de muy baja varianza (video)
movies_cluster <- data %>%
select(budget, revenue, runtime, popularity, voteAvg, voteCount,
genresAmount, productionCoAmount, productionCountriesAmount,
actorsAmount, castWomenAmount, castMenAmount, releaseYear)
movies_cluster <- movies_cluster %>%
drop_na()
# Escalamiento
movies_scaled <- as.data.frame(scale(movies_cluster))
# REsultado
summary(movies_scaled)## budget revenue runtime popularity
## Min. :-0.3407 Min. :-0.2604 Min. :-1.3204 Min. :-0.16689
## 1st Qu.:-0.3407 1st Qu.:-0.2604 1st Qu.:-1.1208 1st Qu.:-0.16654
## Median :-0.3407 Median :-0.2604 Median : 0.3961 Median :-0.11744
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.:-0.3047 3rd Qu.:-0.2566 3rd Qu.: 0.7354 3rd Qu.:-0.02658
## Max. :13.3159 Max. :25.3009 Max. :13.6495 Max. :73.07935
## voteAvg voteCount genresAmount productionCoAmount
## Min. :-1.1230 Min. :-0.3502 Min. :-1.56094 Min. :-0.9052
## 1st Qu.:-1.1230 1st Qu.:-0.3502 1st Qu.:-0.76048 1st Qu.:-0.9052
## Median : 0.4646 Median :-0.3472 Median : 0.03998 Median :-0.4388
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.8762 3rd Qu.:-0.1292 3rd Qu.: 0.84045 3rd Qu.: 0.4938
## Max. : 1.8170 Max. :15.4765 Max. : 5.64322 Max. :11.2197
## productionCountriesAmount actorsAmount castWomenAmount
## Min. :-0.5468 Min. :-0.7805 Min. :-0.6937
## 1st Qu.:-0.1004 1st Qu.:-0.6316 1st Qu.:-0.6937
## Median :-0.1004 Median :-0.2841 Median :-0.3360
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1004 3rd Qu.: 0.2620 3rd Qu.: 0.3795
## Max. :68.6441 Max. :14.7578 Max. :18.2655
## castMenAmount releaseYear
## Min. :-0.1154 Min. :-8.9170
## 1st Qu.:-0.1154 1st Qu.:-0.2983
## Median :-0.1154 Median : 0.6334
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1153 3rd Qu.: 0.6334
## Max. :12.8231 Max. : 0.7111head(movies_scaled)## budget revenue runtime popularity voteAvg voteCount genresAmount
## 1 -0.3406744 -0.2604168 0.5757624 -0.1666585 -1.122999 -0.350246 0.03998455
## 2 -0.3406744 -0.2604168 -1.2605496 -0.1666585 -1.122999 -0.350246 -0.76047775
## 3 -0.3406744 -0.2604168 -1.2805095 -0.1667498 -1.122999 -0.350246 -0.76047775
## 4 -0.3406744 -0.2604168 -1.2206298 -0.1666126 -1.122999 -0.350246 0.84044686
## 5 -0.3406744 -0.2604168 -1.0809104 -0.1666445 -1.122999 -0.350246 -0.76047775
## 6 -0.3406743 -0.2604168 -1.0409906 -0.1667038 -1.122999 -0.350246 -0.76047775
## productionCoAmount productionCountriesAmount actorsAmount castWomenAmount
## 1 -0.9051775 -0.546837 -0.3833393 -0.3359697
## 2 -0.9051775 -0.546837 -0.5819120 -0.6936904
## 3 -0.9051775 -0.546837 -0.6315551 -0.6936904
## 4 -0.9051775 -0.546837 -0.4329824 -0.6936904
## 5 -0.9051775 -0.546837 -0.6315551 -0.6936904
## 6 -0.9051775 -0.546837 -0.6315551 -0.6936904
## castMenAmount releaseYear
## 1 -0.1153524 0.7110926
## 2 -0.1154226 0.7110926
## 3 -0.1154226 0.7110926
## 4 -0.1154226 0.7110926
## 5 -0.1154226 0.7110926
## 6 -0.1154226 0.71109261.2
library(factoextra)## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(dplyr)
movies_sample <- movies_scaled %>% sample_n(1500)
tendencia <- get_clust_tendency(movies_sample, n = 50, graph = TRUE)## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.# --- RESULTADOS
# Hopkins
cat("Estadístico de Hopkins:", tendencia$hopkins_stat, "\n")## Estadístico de Hopkins: 0.9480816# VAT
print(tendencia$plot)
Podemos observar un valor estadístico de hopkins de 0.942, muy cercano
1, lo que indica cierta practicidad en realizar agrupaciones de datos,
la prueba VAT también arroja cómo gráficamente los datos parecen mostrar
ciertas tenedencias, detectamos al menos 4 grupos posibles separados,
por lo que se puede proceder al clustering.
1.3
library(factoextra)
library(NbClust)
library(dplyr)
library(ggplot2)
set.seed(666)
movies_sample_opt <- movies_scaled %>% sample_n(1500)
# Metodo del codo
cat("Generando gráfica del Método del Codo...\n")## Generando gráfica del Método del Codo...grafica_codo <- fviz_nbclust(movies_sample_opt, kmeans, method = "wss") +
labs(title = "Método del Codo para determinar K óptimo",
x = "Número de clústeres (k)",
y = "Suma de Cuadrados Intra-clúster (WSS)")
print(grafica_codo)
# Metodo nbclust
# Usamos invisible() y capture.output() para evitar que NbClust imprima demasiado texto en el PDF
cat("Ejecutando NbClust para evaluar 30 índices...\n")## Ejecutando NbClust para evaluar 30 índices...invisible(capture.output(
resultados_nbclust <- NbClust(data = movies_sample_opt,
distance = "euclidean",
min.nc = 2, max.nc = 10,
method = "kmeans",
index = "all")
))
votos <- as.data.frame(table(resultados_nbclust$Best.nc[1, ]))
colnames(votos) <- c("Clusters", "Frecuencia")
# Grafica
grafica_votos <- ggplot(votos, aes(x = Clusters, y = Frecuencia)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
theme_minimal() +
labs(title = "Número Óptimo de Clústeres - Votación Mayoritaria (NbClust)",
x = "Número de clústeres (k) propuesto",
y = "Frecuencia (Cantidad de índices)") +
theme(plot.title = element_text(face = "bold"))
print(grafica_votos)
Las pruebas realizada con la ayuda de la libreria NbClust dan un por la
regla de la mayoría una recomendación de agrupamiento mediante 4
clusters. Esto es apoyado por el método del codo, dónde gráficamente
observamos un punto de inflección muy claro entre 3 y 4, debido a las
pruebas de Nbcluts decidimos irnos por un total de 4 grupos.
1.4
library(dplyr)
library(ggplot2)
library(tidyr)
library(factoextra)
set.seed(666)
indices_muestra <- sample(1:nrow(movies_cluster), 2000)
# Filtramos
movies_sample_cluster <- movies_cluster[indices_muestra, ]
movies_sample_scaled <- as.data.frame(scale(movies_sample_cluster))
# k-medias
km_res <- kmeans(movies_sample_scaled, centers = 4, nstart = 25)
movies_sample_cluster$Cluster_KMeans <- as.factor(km_res$cluster)
# jerarquico
cat("Calculando matriz de distancias para 2000 registros...\n")## Calculando matriz de distancias para 2000 registros...distancias <- dist(movies_sample_scaled, method = "euclidean")
cat("Generando árbol jerárquico...\n")## Generando árbol jerárquico...hc_res <- hclust(distancias, method = "ward.D2")
grupos_hc <- cutree(hc_res, k = 4)
movies_sample_cluster$Cluster_HC <- as.factor(grupos_hc)
# comparacion
cat("\nMatriz de Confusión (K-Medias vs Jerárquico):\n")##
## Matriz de Confusión (K-Medias vs Jerárquico):tabla_comparacion <- table(K_Medias = movies_sample_cluster$Cluster_KMeans,
Jerarquico = movies_sample_cluster$Cluster_HC)
print(tabla_comparacion)## Jerarquico
## K_Medias 1 2 3 4
## 1 94 835 0 0
## 2 26 0 78 0
## 3 0 0 0 33
## 4 922 8 1 3# pca
grafico_pca <- fviz_cluster(km_res, data = movies_sample_scaled,
geom = "point",
ellipse.type = "convex",
ggtheme = theme_minimal(),
main = "Agrupamiento K-Medias (Muestra 2000 obs)")
print(grafico_pca)
# grafico radar (mi favorito)
centroides_escalados <- movies_sample_scaled %>%
mutate(Cluster = as.factor(km_res$cluster)) %>%
group_by(Cluster) %>%
summarise_all(mean)
centroides_largo <- centroides_escalados %>%
pivot_longer(cols = -Cluster, names_to = "Variable", values_to = "Media_Escalada")
grafico_radar <- ggplot(centroides_largo, aes(x = Variable, y = Media_Escalada, color = Cluster, group = Cluster)) +
geom_polygon(fill = NA, linewidth = 1) +
geom_point(size = 2) +
geom_line(linewidth = 0.5, linetype = "dashed") +
coord_polar() +
theme_minimal() +
labs(title = "Perfil de los 4 Clusters (K-Medias en Muestra)",
subtitle = "Valores estandarizados: 0 es el promedio de la variable",
y = "Media Estandarizada") +
theme(axis.text.x = element_text(angle = 0, size = 10, face = "bold"),
legend.position = "right")
print(grafico_radar)
Podemos observar que ambos métodos de agrupamiento, tanto k-medias como
jerárquico, muestran una tendencia similar en la asignación de registros
a los clusters, aunque no son idénticos. La matriz de confusión revela
que hay cierta superposición entre los grupos formados por ambos
métodos, lo que sugiere que aunque no coinciden perfectamente, sí
capturan patrones similares en los datos. El gráfico PCA muestra una
clara separación entre los clusters formados por k-medias, mientras que
el gráfico de radar para este caso no es lo más eficiente para
representar visualmente lo que están experimentando los datos.
1.5
library(cluster)
library(factoextra)
cat("Calculando el coeficiente de silueta para K-Medias...\n")## Calculando el coeficiente de silueta para K-Medias...# silueta
sil_kmeans <- silhouette(km_res$cluster, dist(movies_sample_scaled))
summary(sil_kmeans)## Silhouette of 2000 units in 4 clusters from silhouette.default(x = km_res$cluster, dist = dist(movies_sample_scaled)) :
## Cluster sizes and average silhouette widths:
## 929 104 33 934
## 0.58556037 0.04467305 0.27439009 0.20627605
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.2569 0.2094 0.3186 0.3752 0.6512 0.7185grafica_silueta <- fviz_silhouette(sil_kmeans,
palette = "jco",
ggtheme = theme_minimal(),
main = "Gráfico de Silueta - Calidad de K-Medias (K=4)")## cluster size ave.sil.width
## 1 1 929 0.59
## 2 2 104 0.04
## 3 3 33 0.27
## 4 4 934 0.21print(grafica_silueta)
El análisis de silueta nos permitió evaluar de manera visual qué tan
bien integradas están las películas dentro de sus respectivos grupos. El
resultado mostró un promedio general positivo, lo que confirma que la
mayoría de las películas comparten características fuertes con su propio
segmento y se diferencian adecuadamente de los demás. Aunque se
observaron algunas películas con valores negativos, esto es
completamente normal en esta industria, ya que representan producciones
“fronterizas” que mezclan presupuestos o atributos de distintos grupos.
En conclusión, esta métrica nos asegura que la segmentación en cuatro
grupos es lo suficientemente sólida y confiable para basar en ella
futuras decisiones comerciales.
1.6
library(dplyr)
library(knitr)
# Calculamos el promedio de las variables originales (sin estandarizar) para cada cluster
# Esto nos permite interpretar los grupos con valores reales (dólares, minutos, cantidad de actores, etc.)
perfil_clusters <- movies_sample_cluster %>%
group_by(Cluster_KMeans) %>%
summarise(
Cantidad_Peliculas = n(),
Presupuesto_Promedio = mean(budget, na.rm = TRUE),
Ingresos_Promedio = mean(revenue, na.rm = TRUE),
Duracion_Promedio = mean(runtime, na.rm = TRUE),
Popularidad_Promedio = mean(popularity, na.rm = TRUE),
Calificacion_Promedio = mean(voteAvg, na.rm = TRUE),
Elenco_Promedio = mean(actorsAmount, na.rm = TRUE)
)
# Mostramos la tabla formateada
kable(perfil_clusters, format = "markdown", digits = 2,
caption = "Perfilamiento de los 4 Clusters (Valores Promedio Originales)")| Cluster_KMeans | Cantidad_Peliculas | Presupuesto_Promedio | Ingresos_Promedio | Duracion_Promedio | Popularidad_Promedio | Calificacion_Promedio | Elenco_Promedio |
|---|---|---|---|---|---|---|---|
| 1 | 929 | 26333.56 | 28750.07 | 25.86 | 2.20 | 0.75 | 3.43 |
| 2 | 104 | 98003490.38 | 368725216.12 | 119.82 | 229.38 | 6.91 | 56.00 |
| 3 | 33 | 155364.24 | 24492.03 | 85.82 | 40.32 | 5.60 | 2.76 |
| 4 | 934 | 10020058.28 | 22152801.87 | 101.59 | 39.40 | 6.47 | 24.64 |
nterpretación comercial de los grupos:
- Grupo 4 (Cine Comercial Exitoso): Es el estándar rentable de la industria; películas populares, de duración normal y buenos ingresos.
- Grupo 2 (Épicas Aclamadas): Producciones muy largas y con elencos gigantes, que logran las mejores calificaciones del público.
- Grupo 1 (Cortometrajes o Amateur): Proyectos de muy corta duración, con presupuestos, elencos y ganancias prácticamente nulos.
- Grupo 3 (Cine Independiente): Películas de duración tradicional pero con presupuesto mínimo; generan poco dinero pero atraen a nichos específicos.
Parte 2
1. Introducción
En esta sección se obtienen reglas de asociación
utilizando el algoritmo Apriori sobre el conjunto de
datos movies_2026.csv.
Se realiza:
- Discretización de variables numéricas.
- Generación de reglas con diferentes niveles de soporte y confianza.
- Evaluación del lift.
- Eliminación de variables muy frecuentes para obtener mejores insights.
2. Carga de Datos
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.1 ✔ readr 2.2.0
## ✔ lubridate 1.9.4 ✔ stringr 1.6.0
## ✔ purrr 1.2.1 ✔ tibble 3.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(arules)## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
##
## Attaching package: 'arules'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following objects are masked from 'package:base':
##
## abbreviate, writelibrary(arulesViz)movies <- read.csv("movies_2026.csv", encoding = "latin1")
str(movies)## 'data.frame': 19883 obs. of 28 variables:
## $ id : int 1627085 1626914 1626898 1626808 1626678 1626234 1626010 1625551 1625043 1624457 ...
## $ budget : num 0 0 0 0 0 1 0 0 0 0 ...
## $ genres : chr "Drama|Crime" "Animation" "Animation" "Thriller|Mystery|Documentary" ...
## $ homePage : chr "" "" "" "" ...
## $ productionCompany : chr "" "" "" "" ...
## $ productionCompanyCountry : chr "" "" "" "" ...
## $ productionCountry : chr "" "" "" "" ...
## $ revenue : num 0 0 0 0 0 1 0 0 0 0 ...
## $ runtime : int 95 3 2 5 12 14 39 90 96 106 ...
## $ video : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ director : chr "Javad Hakami" "Kimmy Gatewood" "Kimmy Gatewood" "Felipe Roldán" ...
## $ actors : chr "Mohsen Ghasabian|Aida Mahiani|Mehran Ghafourian|Payam Ahmadinia|Masoud Karamati|Roya Javidnia|Nasim Adabi|Siavash Cheraghipour" "Kameron Jackson|Laura Weaving|sara weaving|Bertha Williams" "Cedric Mitchell|Cajun mills|Laura Williams" "Tomás Tuchsznajder|Matias Junas|Martin Etcheverry|Romeo Jeirfimczuk|Agustin Pulido|Alec Drach|Franco Serio" ...
## $ actorsPopularity : chr "0.3453|0.1664|0.9684|0.3437|0.3713|0.2437|0.2796|0.2639" "0|0.0071|0|0" "0.0193|0|0.0143" "0|0|0|0|0|0|0" ...
## $ actorsCharacter : chr "|||||||" "Prince Charming|Evil Stepmother|Fairy Godmother|Cinderella" "Aladdin|Jafar|Jasmine" "||||||" ...
## $ originalTitle : chr "غوطه ور" "Cinderella" "Aladdin" "EL ANILLO Y EL DECK" ...
## $ title : chr "Immersed" "Cinderella" "Aladdin" "THE RING AND THE DECK" ...
## $ originalLanguage : chr "fa" "en" "en" "es" ...
## $ popularity : num 0.0357 0.0357 0.0214 0.0429 0.0379 ...
## $ releaseDate : chr "2026-02-01" "2026-02-01" "2026-02-01" "2026-02-01" ...
## $ voteAvg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ voteCount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ genresAmount : int 2 1 1 3 1 1 1 1 3 1 ...
## $ productionCoAmount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ productionCountriesAmount: int 0 0 0 0 0 0 0 1 1 0 ...
## $ actorsAmount : int 8 4 3 7 3 3 5 4 5 5 ...
## $ castWomenAmount : int 2 0 0 0 0 0 0 3 1 2 ...
## $ castMenAmount : int 5 0 0 0 0 0 3 0 3 3 ...
## $ releaseYear : int 2026 2026 2026 2026 2026 2026 2026 2026 2026 2026 ...summary(movies)## id budget genres homePage
## Min. : 5 Min. : 0 Length:19883 Length:19883
## 1st Qu.: 146220 1st Qu.: 0 Class :character Class :character
## Median : 869623 Median : 0 Mode :character Mode :character
## Mean : 902240 Mean : 9413280
## 3rd Qu.:1589602 3rd Qu.: 1000000
## Max. :1627166 Max. :380000000
##
## productionCompany productionCompanyCountry productionCountry
## Length:19883 Length:19883 Length:19883
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## revenue runtime video director
## Min. :0.000e+00 Min. : 0.00 Mode :logical Length:19883
## 1st Qu.:0.000e+00 1st Qu.: 10.00 FALSE:19313 Class :character
## Median :0.000e+00 Median : 86.00 TRUE :84 Mode :character
## Mean :2.879e+07 Mean : 66.09 NA's :486
## 3rd Qu.:3.306e+05 3rd Qu.:103.00
## Max. :2.847e+09 Max. :750.00
##
## actors actorsPopularity actorsCharacter originalTitle
## Length:19883 Length:19883 Length:19883 Length:19883
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## title originalLanguage popularity releaseDate
## Length:19883 Length:19883 Min. :0.000e+00 Length:19883
## Class :character Class :character 1st Qu.:5.460e-02 Class :character
## Mode :character Mode :character Median :8.502e+00 Mode :character
## Mean :2.625e+01
## 3rd Qu.:2.224e+01
## Max. :1.147e+04
##
## voteAvg voteCount genresAmount productionCoAmount
## Min. : 0.000 Min. : 0.0 Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 0.0 1st Qu.: 1.000 1st Qu.: 0.000
## Median : 5.400 Median : 6.0 Median : 2.000 Median : 1.000
## Mean : 3.837 Mean : 675.9 Mean : 1.949 Mean : 1.973
## 3rd Qu.: 6.800 3rd Qu.: 423.0 3rd Qu.: 3.000 3rd Qu.: 3.000
## Max. :10.000 Max. :30788.0 Max. :16.000 Max. :89.000
##
## productionCountriesAmount actorsAmount castWomenAmount castMenAmount
## Min. : 0.00 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 1.00 1st Qu.: 3 1st Qu.: 0 1st Qu.: 0
## Median : 1.00 Median : 9 Median : 2 Median : 3
## Mean : 1.23 Mean : 1082 Mean : 3517 Mean : 8224
## 3rd Qu.: 1.00 3rd Qu.: 21 3rd Qu.: 6 3rd Qu.: 12
## Max. :155.00 Max. :919590 Max. :922162 Max. :922017
## NA's :37 NA's :162
## releaseYear
## Min. :1902
## 1st Qu.:2013
## Median :2021
## Mean :2017
## 3rd Qu.:2025
## Max. :2026
## NA's :23. Selección de Variables
Seleccionamos las variables relevantes para minería de reglas:
- genres
- originalLanguage
- budget
- revenue
- runtime
- popularity
- voteAvg
- voteCount
movies2 <- movies %>%
select(genres, originalLanguage, budget, revenue, runtime,
popularity, voteAvg, voteCount) %>%
drop_na(genres)4. Discretización de Variables Numéricas
El algoritmo Apriori requiere variables categóricas. Se discretizan las variables numéricas usando cuantiles (3 categorías).
movies2 <- movies2 %>%
mutate(
budget_cat = discretize(budget, method = "frequency", categories = 3),
revenue_cat = discretize(revenue, method = "frequency", categories = 3),
runtime_cat = discretize(runtime, method = "frequency", categories = 3),
popularity_cat = discretize(popularity, method = "frequency", categories = 3),
voteAvg_cat = discretize(voteAvg, method = "frequency", categories = 3),
voteCount_cat = discretize(voteCount, method = "frequency", categories = 3)
)## Warning: There were 10 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `budget_cat = discretize(budget, method = "frequency",
## categories = 3)`.
## Caused by warning in `discretize()`:
## ! Parameter categories is deprecated. Use breaks instead! Also, the default method is now frequency!
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 9 remaining warnings.movies2 <- movies2 %>%
select(genres, originalLanguage,
budget_cat, revenue_cat, runtime_cat,
popularity_cat, voteAvg_cat, voteCount_cat)5. Conversión a Formato Transaccional
movies_trans <- as(movies2, "transactions")## Warning: Column(s) 1, 2 not logical or factor. Applying default discretization
## (see '? discretizeDF').summary(movies_trans)## transactions as itemMatrix in sparse format with
## 19883 rows (elements/itemsets/transactions) and
## 2934 columns (items) and a density of 0.002726653
##
## most frequent items:
## budget_cat=[0,3.8e+08] revenue_cat=[0,2.85e+09] voteCount_cat=[0,193)
## 19883 19883 13251
## voteAvg_cat=[0,6.4) originalLanguage=en (Other)
## 13091 11961 80995
##
## element (itemset/transaction) length distribution:
## sizes
## 8
## 19883
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8 8 8 8 8 8
##
## includes extended item information - examples:
## labels variables levels
## 1 genres= genres
## 2 genres=Action genres Action
## 3 genres=Action|Adventure genres Action|Adventure
##
## includes extended transaction information - examples:
## transactionID
## 1 1
## 2 2
## 3 36. Generación de Reglas
6.1 Soporte = 0.05 | Confianza = 0.6
rules1 <- apriori(movies_trans,
parameter = list(supp = 0.05,
conf = 0.6,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 994
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.08s].
## sorting and recoding items ... [19 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [1583 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].inspect(sort(rules1, by = "lift")[1:10])## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [2] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [3] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [4] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [5] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [6] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [7] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [8] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [9] {originalLanguage=en,
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
## [10] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463Discusión
Con soporte alto se generan pocas reglas y suelen estar dominadas por categorías frecuentes.
6.2 Soporte = 0.03 | Confianza = 0.7
rules2 <- apriori(movies_trans,
parameter = list(supp = 0.03,
conf = 0.7,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.03 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 596
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.08s].
## sorting and recoding items ... [21 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [2078 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].inspect(sort(rules2, by = "lift")[1:10])## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [2] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [3] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [4] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [5] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [6] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [7] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [8] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [9] {originalLanguage=en,
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
## [10] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463Discusión
Se obtiene un mejor equilibrio entre cantidad y calidad de reglas.
6.3 Soporte = 0.01 | Confianza = 0.8
rules3 <- apriori(movies_trans,
parameter = list(supp = 0.01,
conf = 0.8,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.01 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 198
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.08s].
## sorting and recoding items ... [33 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 8 done [0.01s].
## writing ... [3746 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].inspect(sort(rules3, by = "lift")[1:10])## lhs rhs support confidence coverage lift count
## [1] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [2] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [3] {genres=Animation,
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [4] {genres=Animation,
## budget_cat=[0,3.8e+08],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [5] {genres=Animation,
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [6] {genres=Animation,
## budget_cat=[0,3.8e+08],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [7] {genres=Animation,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [8] {genres=Animation,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [9] {genres=Animation,
## popularity_cat=[0,0.0996)} => {runtime_cat=[0,20)} 0.01101443 0.9480519 0.01161797 2.885369 219
## [10] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01101443 0.9480519 0.01161797 2.885369 219Discusión
Se generan muchas reglas. Aunque la confianza es alta, algunas pueden tener bajo soporte práctico.
7. Identificación de Ítems Muy Frecuentes
itemFrequencyPlot(movies_trans, topN = 20, type = "absolute")
Es probable que el idioma inglés (“en”) y categorías de bajo presupuesto o bajo revenue dominen las reglas.
8. Eliminación de Variable Muy Frecuente
Se elimina el idioma inglés para evaluar si emergen reglas más interesantes.
movies3 <- movies2 %>%
filter(originalLanguage != "en")
movies_trans2 <- as(movies3, "transactions")## Warning: Column(s) 1, 2 not logical or factor. Applying default discretization
## (see '? discretizeDF').rules_filtered <- apriori(movies_trans2,
parameter = list(supp = 0.02,
conf = 0.7,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.02 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 158
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1324 item(s), 7922 transaction(s)] done [0.03s].
## sorting and recoding items ... [28 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [2852 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].inspect(sort(rules_filtered, by = "lift")[1:10])## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=ja,
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [2] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [3] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [4] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [5] {originalLanguage=ja,
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [6] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [7] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [8] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [9] {originalLanguage=ja,
## runtime_cat=[20,97),
## voteAvg_cat=[6.4,10]} => {popularity_cat=[16.7,1.15e+04]} 0.02272153 0.8071749 0.02814946 4.311827 180
## [10] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[20,97),
## voteAvg_cat=[6.4,10]} => {popularity_cat=[16.7,1.15e+04]} 0.02272153 0.8071749 0.02814946 4.311827 180Discusión
Al eliminar una variable dominante:
- Se reduce el sesgo en las reglas.
- Aparecen asociaciones más específicas.
- Se obtienen mejores insights entre género, presupuesto, popularidad y votaciones.
9. Conclusiones
- La discretización es esencial para aplicar Apriori.
- El soporte controla la frecuencia mínima.
- La confianza mide la fuerza predictiva.
- El lift permite identificar asociaciones no triviales.
- Eliminar variables muy frecuentes mejora la calidad de los resultados.
- Un equilibrio adecuado (supp ≈ 0.02–0.03 y conf ≈ 0.7) genera reglas interpretables.
10. Visualización de Reglas
plot(rules_filtered, method = "graph", engine = "htmlwidget")## Warning: Too many rules supplied. Only plotting the best 100 using 'lift'
## (change control parameter max if needed).Parte 3
if(! "psych" %in% installed.packages()) install.packages("psych", depend = TRUE)
if(! "FactoMineR" %in% installed.packages()) install.packages("FactoMineR", depend = TRUE)
if(! "corrplot" %in% installed.packages()) install.packages("corrplot", depend = TRUE)
if(! "fpc" %in% installed.packages()) install.packages("fpc", depend = TRUE)
if(! "factoextra" %in% installed.packages()) install.packages("factoextra", depend = TRUE)
if(! "PCAmixdata" %in% installed.packages()) install.packages("PCAmixdata", depend = TRUE)
if(! "paran" %in% installed.packages()) install.packages("paran", depend = TRUE)
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphalibrary(FactoMineR)
library(fpc)
library(factoextra)
library(corrplot)## corrplot 0.95 loadedlibrary(PCAmixdata)
library(paran)## Loading required package: MASS##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectdata <- read.csv("movies_2026.csv", stringsAsFactors = FALSE)
numeric_vars <- c("budget", "revenue", "runtime", "popularity",
"voteAvg", "voteCount", "genresAmount",
"productionCoAmount", "productionCountriesAmount",
"actorsAmount", "castWomenAmount", "castMenAmount")
categorical_vars <- c("genres", "originalLanguage", "video", "director",
"actors", "productionCompany", "productionCountry", "homePage")
numeric_vars_list <- paste(numeric_vars, collapse = ", ")
categorical_vars_list <- paste(categorical_vars, collapse = ", ")Descripción de los datos
El análisis se realizó sobre un conjunto de 19,883 películas obtenidas de la plataforma “The Movie DB”. A continuación, se describen las variables incluidas en el estudio:
| Variable | Descripción |
|---|---|
| id | Identificador único de la película. |
| popularity | Índice de popularidad calculado semanalmente. |
| budget | Presupuesto de la película (en USD). |
| revenue | Ingresos generados por la película (en USD). |
| runtime | Duración de la película en minutos. |
| voteAvg | Promedio de votos en la plataforma. |
| voteCount | Número de votos recibidos. |
| genresAmount | Cantidad de géneros que representa la película. |
| productionCoAmount | Cantidad de compañías productoras involucradas. |
| productionCountriesAmount | Cantidad de países donde se rodó la película. |
| actorsAmount | Cantidad de actores en el elenco. |
| castWomenAmount | Cantidad de actrices en el elenco. |
| castMenAmount | Cantidad de actores masculinos en el elenco. |
| releaseYear | Año de lanzamiento. |
Variables numéricas seleccionadas para el PCA
Para el análisis de componentes principales se utilizarán 12 variables numéricas que aportan información cuantitativa relevante sobre las películas: budget, revenue, runtime, popularity, voteAvg, voteCount, genresAmount, productionCoAmount, productionCountriesAmount, actorsAmount, castWomenAmount, castMenAmount.
Se excluyen:
- id: Es un identificador único, no aporta información para el análisis.
- releaseYear: Presenta muy poca variabilidad (la mayoría de registros pertenecen a años similares) y no contribuye a diferenciar entre películas.
data_numeric <- data[, numeric_vars]
data_numeric <- na.omit(data_numeric)
str(data_numeric)## 'data.frame': 19721 obs. of 12 variables:
## $ budget : num 0 0 0 0 0 1 0 0 0 0 ...
## $ revenue : num 0 0 0 0 0 1 0 0 0 0 ...
## $ runtime : int 95 3 2 5 12 14 39 90 96 106 ...
## $ popularity : num 0.0357 0.0357 0.0214 0.0429 0.0379 ...
## $ voteAvg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ voteCount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ genresAmount : int 2 1 1 3 1 1 1 1 3 1 ...
## $ productionCoAmount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ productionCountriesAmount: int 0 0 0 0 0 0 0 1 1 0 ...
## $ actorsAmount : int 8 4 3 7 3 3 5 4 5 5 ...
## $ castWomenAmount : int 2 0 0 0 0 0 0 3 1 2 ...
## $ castMenAmount : int 5 0 0 0 0 0 3 0 3 3 ...
## - attr(*, "na.action")= 'omit' Named int [1:162] 13058 13930 13972 14007 14077 14168 14542 14579 14602 14628 ...
## ..- attr(*, "names")= chr [1:162] "13058" "13930" "13972" "14007" ...summary(data_numeric)## budget revenue runtime popularity
## Min. : 0 Min. :0.000e+00 Min. : 0.00 Min. :0.000e+00
## 1st Qu.: 0 1st Qu.:0.000e+00 1st Qu.: 10.00 1st Qu.:5.370e-02
## Median : 0 Median :0.000e+00 Median : 86.00 Median :7.741e+00
## Mean : 9478444 Mean :2.900e+07 Mean : 66.15 Mean :2.614e+01
## 3rd Qu.: 1000000 3rd Qu.:4.227e+05 3rd Qu.:103.00 3rd Qu.:2.198e+01
## Max. :380000000 Max. :2.847e+09 Max. :750.00 Max. :1.147e+04
## voteAvg voteCount genresAmount productionCoAmount
## Min. : 0.000 Min. : 0.0 Min. :0.00 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 0.0 1st Qu.:1.00 1st Qu.: 0.000
## Median : 5.400 Median : 6.0 Median :2.00 Median : 1.000
## Mean : 3.819 Mean : 681.3 Mean :1.95 Mean : 1.941
## 3rd Qu.: 6.800 3rd Qu.: 430.0 3rd Qu.:3.00 3rd Qu.: 3.000
## Max. :10.000 Max. :30788.0 Max. :9.00 Max. :26.000
## productionCountriesAmount actorsAmount castWomenAmount castMenAmount
## Min. : 0.000 Min. : 0.00 Min. : 0.000 Min. : 0
## 1st Qu.: 1.000 1st Qu.: 3.00 1st Qu.: 0.000 1st Qu.: 0
## Median : 1.000 Median : 10.00 Median : 2.000 Median : 3
## Mean : 1.225 Mean : 15.72 Mean : 3.878 Mean : 8224
## 3rd Qu.: 1.000 3rd Qu.: 21.00 3rd Qu.: 6.000 3rd Qu.: 12
## Max. :155.000 Max. :313.00 Max. :106.000 Max. :9220173.1 Transformación de variables categóricas para incluirlas en el PCA
Antes de proceder con el PCA, es necesario evaluar si vale la pena transformar las variables categóricas del dataset para incluirlas en el análisis.
Variables categóricas del dataset
El dataset contiene 8 variables categóricas: genres, originalLanguage, video, director, actors, productionCompany, productionCountry, homePage.
- genres: Géneros de la película, separados por
|. Ejemplo: “Drama|Crime”. Cada película puede tener múltiples géneros. - originalLanguage: Idioma original de la película (e.g., “en”, “fa”, “es”).
- video: Indica si tiene videos promocionales (TRUE/FALSE).
- director: Director de la película.
- actors: Elenco de la película, separado por
|. - productionCompany: Compañías productoras.
- productionCountry: Países de producción.
- homePage: Página web de la película.
Análisis de viabilidad
cardinalidad <- sapply(categorical_vars, function(v) length(unique(data[[v]])))
data.frame(Variable = names(cardinalidad), Valores_Unicos = cardinalidad, row.names = NULL)## Variable Valores_Unicos
## 1 genres 2828
## 2 originalLanguage 94
## 3 video 3
## 4 director 13669
## 5 actors 16734
## 6 productionCompany 12235
## 7 productionCountry 1407
## 8 homePage 5489cat("\nDistribución de 'video':\n")##
## Distribución de 'video':table(data$video)##
## FALSE TRUE
## 19313 84Opciones de transformación
One-Hot Encoding: Consiste en crear una columna binaria por cada categoría. Sin embargo, variables como
directoryactorstienen miles de valores únicos, lo que generaría una matriz extremadamente dispersa y de altísima dimensionalidad, lo cual contradice el objetivo del PCA (reducir dimensiones).Separación de géneros: La variable
genrespodría separarse por|y codificarse como columnas binarias por género individual. Aunque es viable, esto añade múltiples columnas con baja frecuencia para géneros poco comunes.PCAmixdata: El paquete
PCAmixdatapermite realizar un PCA sobre datos mixtos (numéricos y categóricos). Sin embargo, requiere que las variables categóricas tengan una cantidad razonable de niveles. Con la cardinalidad observada endirector,actorsyproductionCompany, el análisis sería computacionalmente costoso y los resultados difíciles de interpretar.Variable
video: Aunque es trivialmente codificable como 0/1, tiene varianza cercana a cero porque casi todas las observaciones tienen el mismo valor (FALSE), por lo que no aportaría al PCA.
Conclusión
No vale la pena incluir las variables categóricas en el PCA. Las razones principales son:
- La altísima cardinalidad de variables como
director,actorsyproductionCompanygeneraría una explosión dimensional. - Las variables con baja cardinalidad (
video) tienen varianza casi nula. - El PCA está diseñado para capturar la variabilidad en variables continuas; las transformaciones binarias de categóricas producen matrices dispersas que dificultan la interpretación de los componentes.
Se procederá con las 12 variables numéricas seleccionadas previamente.
3.2 ¿Es conveniente hacer un Análisis de Componentes Principales?
3.2.1 Determinante de la Matriz de Correlación
Lo primero que vamos a hacer es calcular el determinante de la matriz de correlación. Si este es cercano a 0 significa que hay multicolinealidad, es decir, las variables están relacionadas entre sí.
rcor <- cor(data_numeric, use = "pairwise.complete.obs")El determinante es: 0.004625.
El valor obtenido (0.004625) es muy cercano a 0, lo que confirma la presencia de multicolinealidad entre las variables. Esto significa que las variables numéricas comparten información redundante, lo cual es una condición favorable para aplicar PCA: el análisis buscará resumir esa redundancia en pocas componentes que capturen la mayor parte de la variabilidad.
3.2.2 KMO (Kaiser-Meyer-Olkin)
Se debe analizar si se puede usar el análisis factorial para formar las combinaciones lineales de las variables. El índice KMO mide la adecuación muestral según la siguiente escala:
- < 0.5: Inaceptable
- 0.5 - 0.6: Miserable
- 0.6 - 0.7: Mediocre
- 0.7 - 0.8: Aceptable
- 0.8 - 0.9: Meritorio
- > 0.9: Excelente
resultado_kmo <- KMO(as.matrix(data_numeric))
resultado_kmo## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = as.matrix(data_numeric))
## Overall MSA = 0.82
## MSA for each item =
## budget revenue runtime
## 0.84 0.75 0.90
## popularity voteAvg voteCount
## 0.92 0.87 0.85
## genresAmount productionCoAmount productionCountriesAmount
## 0.91 0.90 0.57
## actorsAmount castWomenAmount castMenAmount
## 0.81 0.81 0.50El índice general obtenido (Overall MSA = 0.82) se clasifica como meritorio, lo que indica que los datos son adecuados para un análisis factorial. Esto respalda fuertemente la aplicación de PCA.
Al examinar los valores MSA individuales por variable, se observa que
la mayoría superan 0.8, lo que refuerza su inclusión. Las variables
castMenAmount (MSA = 0.5) y
productionCountriesAmount (MSA = 0.57) presentan los
valores más bajos, en el umbral de lo aceptable, lo que sugiere que
estas variables comparten menos estructura factorial con el resto. No
obstante, al estar por encima de 0.5, se mantienen en el análisis.
3.2.3 Test de Esfericidad de Bartlett
H0: La matriz de correlaciones es igual a la matriz identidad.
Se busca rechazar la hipótesis nula de que la matriz de correlaciones es
igual a la matriz identidad y por ende, que existe suficiente
multicolinealidad entre las variables. En una matriz de identidad la
diagonal es 1, y los valores fuera de la diagonal son 0. Esto implica
que no hay más colinealidad entre las variables que la que hay entre
cada variable consigo misma.
resultado_bartlett <- cortest.bartlett(data_numeric)## R was not square, finding R from dataresultado_bartlett## $chisq
## [1] 105995.9
##
## $p.value
## [1] 0
##
## $df
## [1] 66El estadístico chi-cuadrado obtenido es 105,995.9 con 66 grados de libertad, y un valor p de 0. Al ser el valor p prácticamente 0 (mucho menor a 0.05), rechazamos H0 y concluimos que la matriz de correlaciones es significativamente diferente a la matriz identidad. Esto confirma que existe suficiente multicolinealidad entre las variables y que el análisis factorial (y por tanto el PCA) es apropiado para estos datos.
En conjunto, tanto el determinante cercano a 0, el KMO meritorio (0.82) y el rechazo contundente de la prueba de Bartlett confirman que es conveniente aplicar un Análisis de Componentes Principales a este dataset.
3.2.4 Matriz de Correlación
A continuación se visualiza la matriz de correlación para identificar las relaciones más fuertes entre variables.
matriz <- cor(data_numeric, use = "pairwise.complete.obs")
corrplot(matriz, method = "color", type = "upper",
tl.cex = 0.7, tl.col = "black",
addCoef.col = "black", number.cex = 0.5)
En la matriz de correlación se pueden identificar varios patrones relevantes:
budgetyrevenuepresentan una correlación positiva notable, lo cual es esperable: películas con mayor presupuesto tienden a generar mayores ingresos.budget,revenueyvoteCountforman un bloque correlacionado que refleja la dimensión comercial de las películas.voteCountse asocia con mayor visibilidad y presencia en la plataforma.actorsAmountycastWomenAmountmuestran correlación positiva, lo cual es lógico porque la cantidad de actrices es un subconjunto del elenco total. Sin embargo,castMenAmountpresenta un comportamiento anómalo con correlaciones bajas respecto al resto de variables del elenco, posiblemente debido a valores extremos en esta variable (su media es desproporcionadamente alta respecto a la mediana, sugiriendo la presencia de outliers severos).runtimese correlaciona moderadamente convoteAvg,genresAmountyproductionCoAmount, lo que sugiere que las películas más largas tienden a ser producciones más complejas y mejor evaluadas.popularitymuestra correlaciones débiles con la mayoría de variables, lo que indica que es una métrica más independiente que depende de factores temporales y externos no capturados por las demás variables.productionCountriesAmounttiene correlaciones bajas con el bloque financiero, lo que sugiere que la cantidad de países de producción no se relaciona linealmente con el éxito comercial.
3.3 Análisis de Componentes Principales
3.3.1 Ejecución del PCA
Para hacer el análisis de componentes principales es necesario
normalizar los datos. La función prcomp lo hace
automáticamente con el parámetro scale = TRUE.
compPrinc <- prcomp(data_numeric, scale = TRUE)
compPrinc## Standard deviations (1, .., p=12):
## [1] 2.1417968 1.2910075 1.1465400 0.9769159 0.8708341 0.7892329 0.7484470
## [8] 0.6898950 0.6292771 0.5558549 0.4365312 0.4052102
##
## Rotation (n x k) = (12 x 12):
## PC1 PC2 PC3 PC4
## budget 0.342285418 -0.32776715 -0.2201714 -0.02606525
## revenue 0.321001751 -0.40425076 -0.3023611 -0.05327695
## runtime 0.332555927 0.25098687 0.1669475 0.01207898
## popularity 0.119777261 -0.07016405 -0.1535316 0.93630812
## voteAvg 0.318271825 0.30303692 0.1688037 0.09366696
## voteCount 0.343544478 -0.32460352 -0.2140084 -0.11546006
## genresAmount 0.262657432 0.18820240 0.2079680 0.16901057
## productionCoAmount 0.283443240 0.22677105 0.2381743 0.03425571
## productionCountriesAmount 0.092514975 0.46150814 -0.4868708 -0.09912764
## actorsAmount 0.387228908 -0.02185237 0.1302115 -0.16601710
## castWomenAmount 0.357354729 0.09358258 0.0796546 -0.17035392
## castMenAmount 0.001456695 0.39365410 -0.6115913 -0.03758186
## PC5 PC6 PC7 PC8
## budget 0.16753892 0.09270632 0.05719013 0.06290760
## revenue 0.16875832 0.04286622 -0.04405409 -0.09286877
## runtime -0.04609476 0.01213607 -0.36793408 -0.42507970
## popularity -0.27037547 0.01577473 0.04698612 0.02229141
## voteAvg 0.12416892 -0.17044979 -0.35470765 -0.31947089
## voteCount 0.09612636 0.05207196 -0.12226146 -0.11189998
## genresAmount 0.63853719 -0.38183294 0.45125657 0.16677717
## productionCoAmount 0.11961083 0.75030086 -0.09119477 0.45775242
## productionCountriesAmount -0.05977025 0.29956595 0.51531170 -0.39216164
## actorsAmount -0.38334628 -0.18861920 0.08907836 0.21279243
## castWomenAmount -0.51518274 -0.22868284 0.25727617 0.18675624
## castMenAmount 0.07475907 -0.26654588 -0.40597889 0.46940809
## PC9 PC10 PC11 PC12
## budget -0.235457891 -0.658723280 -0.200415842 3.909468e-01
## revenue 0.016687664 -0.006227415 0.469002032 -6.149115e-01
## runtime -0.673846303 0.148944964 0.055533221 2.677972e-02
## popularity 0.001511056 0.059568656 -0.029639711 1.966794e-05
## voteAvg 0.624699237 -0.327042681 0.001935764 -6.593754e-03
## voteCount 0.263254603 0.634849013 -0.219634689 3.968403e-01
## genresAmount -0.111751117 0.161638207 0.009567095 -9.782031e-03
## productionCoAmount 0.067550948 0.055082174 0.079050354 -3.709927e-02
## productionCountriesAmount 0.058193080 -0.004913406 -0.108414258 -6.138742e-02
## actorsAmount -0.015409311 0.000626347 -0.604399118 -4.514158e-01
## castWomenAmount 0.058179493 -0.003113240 0.551596145 3.189729e-01
## castMenAmount -0.081226106 0.033562862 0.003774840 6.414452e-03El resumen del modelo es el siguiente:
summary(compPrinc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000También ejecutamos el PCA con FactoMineR::PCA() para
obtener información adicional:
compPrincPCA <- PCA(data_numeric, ncp = ncol(data_numeric), scale.unit = TRUE, graph = FALSE)
summary(compPrincPCA)##
## Call:
## PCA(X = data_numeric, scale.unit = TRUE, ncp = ncol(data_numeric),
## graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 4.587 1.667 1.315 0.954 0.758 0.623 0.560
## % of var. 38.227 13.889 10.955 7.953 6.320 5.191 4.668
## Cumulative % of var. 38.227 52.117 63.071 71.024 77.344 82.535 87.203
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12
## Variance 0.476 0.396 0.309 0.191 0.164
## % of var. 3.966 3.300 2.575 1.588 1.368
## Cumulative % of var. 91.169 94.469 97.044 98.632 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr
## 1 | 1.822 | -1.072 0.001 0.346 | -0.372 0.000
## 2 | 2.390 | -2.097 0.005 0.770 | -1.013 0.003
## 3 | 2.413 | -2.123 0.005 0.774 | -1.017 0.003
## 4 | 2.365 | -1.606 0.003 0.461 | -0.705 0.002
## 5 | 2.314 | -2.057 0.005 0.790 | -0.967 0.003
## 6 | 2.295 | -2.043 0.005 0.793 | -0.957 0.003
## 7 | 2.089 | -1.839 0.004 0.775 | -0.833 0.002
## 8 | 1.899 | -1.287 0.002 0.459 | -0.321 0.000
## 9 | 2.012 | -0.935 0.001 0.216 | -0.024 0.000
## 10 | 2.082 | -1.266 0.002 0.370 | -0.464 0.001
## cos2 Dim.3 ctr cos2
## 1 0.042 | -0.214 0.000 0.014 |
## 2 0.180 | 0.314 0.000 0.017 |
## 3 0.177 | 0.323 0.000 0.018 |
## 4 0.089 | -0.045 0.000 0.000 |
## 5 0.175 | 0.290 0.000 0.016 |
## 6 0.174 | 0.283 0.000 0.015 |
## 7 0.159 | 0.187 0.000 0.008 |
## 8 0.029 | 0.198 0.000 0.011 |
## 9 0.000 | -0.133 0.000 0.004 |
## 10 0.050 | -0.064 0.000 0.001 |
##
## Variables (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## budget | 0.733 11.716 0.537 | -0.423 10.743 0.179 |
## revenue | 0.688 10.304 0.473 | -0.522 16.342 0.272 |
## runtime | 0.712 11.059 0.507 | 0.324 6.299 0.105 |
## popularity | 0.257 1.435 0.066 | -0.091 0.492 0.008 |
## voteAvg | 0.682 10.130 0.465 | 0.391 9.183 0.153 |
## voteCount | 0.736 11.802 0.541 | -0.419 10.537 0.176 |
## genresAmount | 0.563 6.899 0.316 | 0.243 3.542 0.059 |
## productionCoAmount | 0.607 8.034 0.369 | 0.293 5.143 0.086 |
## productionCountriesAmount | 0.198 0.856 0.039 | 0.596 21.299 0.355 |
## actorsAmount | 0.829 14.995 0.688 | -0.028 0.048 0.001 |
## Dim.3 ctr cos2
## budget 0.252 4.848 0.064 |
## revenue 0.347 9.142 0.120 |
## runtime -0.191 2.787 0.037 |
## popularity 0.176 2.357 0.031 |
## voteAvg -0.194 2.849 0.037 |
## voteCount 0.245 4.580 0.060 |
## genresAmount -0.238 4.325 0.057 |
## productionCoAmount -0.273 5.673 0.075 |
## productionCountriesAmount 0.558 23.704 0.312 |
## actorsAmount -0.149 1.696 0.022 |Selección de Componentes
Regla de Kaiser
Los valores propios (eigenvalues) de cada componente son los siguientes:
valores_propios <- compPrinc$sdev^2
nombres_pc <- paste0("PC", 1:length(valores_propios))
data.frame(Componente = nombres_pc, Valor_Propio = round(valores_propios, 4))## Componente Valor_Propio
## 1 PC1 4.5873
## 2 PC2 1.6667
## 3 PC3 1.3146
## 4 PC4 0.9544
## 5 PC5 0.7584
## 6 PC6 0.6229
## 7 PC7 0.5602
## 8 PC8 0.4760
## 9 PC9 0.3960
## 10 PC10 0.3090
## 11 PC11 0.1906
## 12 PC12 0.1642Según la regla de Kaiser, debemos quedarnos con los componentes que tienen valores propios mayores a 1. Los componentes con valor propio menor a 1 explican menos varianza que una sola variable original estandarizada, por lo que no aportan información significativa.
En este caso, los primeros 3 componentes cumplen la regla de Kaiser (PC1 = 4.59, PC2 = 1.67, PC3 = 1.31), mientras que PC4 (0.95) ya cae por debajo de 1.
Gráfico de Sedimentación (Scree Plot)
El gráfico de sedimentación permite identificar visualmente el “codo” donde la varianza explicada por cada componente adicional comienza a estabilizarse.
fviz_eig(compPrinc, addlabels = TRUE, ylim = c(0, 80))## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
fviz_eig(compPrinc, addlabels = TRUE, choice = c("eigenvalue"), ylim = c(0, 5))## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
El primer gráfico muestra el porcentaje de varianza explicada por cada componente, mientras que el segundo muestra los valores propios. Se busca el punto donde la curva se estabiliza (“el codo”), lo que indica que los componentes adicionales ya no aportan información sustancial.
Porcentaje de Varianza Explicada
summary(compPrinc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000Se busca retener suficientes componentes para explicar una proporción adecuada de la varianza total.
varianza_tabla <- data.frame(
Componente = paste0("PC", 1:length(valores_propios)),
Valor_Propio = round(valores_propios, 4),
Porcentaje_Varianza = round(valores_propios / sum(valores_propios) * 100, 2),
Varianza_Acumulada = round(cumsum(valores_propios / sum(valores_propios) * 100), 2)
)
varianza_tabla## Componente Valor_Propio Porcentaje_Varianza Varianza_Acumulada
## 1 PC1 4.5873 38.23 38.23
## 2 PC2 1.6667 13.89 52.12
## 3 PC3 1.3146 10.95 63.07
## 4 PC4 0.9544 7.95 71.02
## 5 PC5 0.7584 6.32 77.34
## 6 PC6 0.6229 5.19 82.53
## 7 PC7 0.5602 4.67 87.20
## 8 PC8 0.4760 3.97 91.17
## 9 PC9 0.3960 3.30 94.47
## 10 PC10 0.3090 2.57 97.04
## 11 PC11 0.1906 1.59 98.63
## 12 PC12 0.1642 1.37 100.00Con los primeros 3 componentes (regla de Kaiser) se explica aproximadamente el 63.1% de la varianza total. Si se desea alcanzar al menos el 80%, es necesario retener 6 componentes (82.5% acumulado). Existe un compromiso entre parsimonia (menos componentes, más fáciles de interpretar) y cobertura de varianza. Para este análisis, se consideran los 3 primeros componentes como los más relevantes por su interpretabilidad y por superar el umbral de Kaiser, aunque se reconoce que no capturan la totalidad de la variabilidad del dataset.
Prueba de Paralelismo (Horn’s Parallel Analysis)
¿Cómo funciona la Prueba de Paralelismo de Horn?
Se calculan los valores propios del PCA basado en los datos reales. Se generan múltiples conjuntos de datos aleatorios con el mismo tamaño que los datos originales (mismo número de variables y observaciones). Se realiza un PCA sobre los datos aleatorios y se extraen los valores propios esperados de cada componente. Se comparan los valores propios reales con los esperados: Si un componente tiene un valor propio mayor que el de los datos simulados, significa que explica más varianza de la que se esperaría por azar, por lo que se retiene. Si el valor propio es menor o igual al de los datos aleatorios, el componente no se retiene porque su explicación de varianza es insignificante.
En los resultados de esta prueba los valores simulados son los de la columna “Adjusted Eigenvalue” y los valores reales son “Unadjusted Eigenvalue”. Se retienen los componentes cuyo valor propio real sea mayor que el simulado.
paran(data_numeric, graph = TRUE)## Using eigendecomposition of correlation matrix.##
## Computing: 10% 20% 30% 40% 50% 60% 70% 80% 90% 100%##
## Results of Horn's Parallel Analysis for component retention
## 360 iterations, using the mean estimate
##
## ──────────────────────────────────────────────────
## Component Adjusted Unadjusted Estimated
## Eigenvalue Eigenvalue Bias
## ──────────────────────────────────────────────────
## 1 4.547173 4.587293 0.040119
## 2 1.636675 1.666700 0.030024
## 3 1.292525 1.314553 0.022028
## ──────────────────────────────────────────────────
## Criterion: retain adjusted eigenvalues > 1.
## (3 components retained)
Carga Factorial Interpretativa
Se basa en la interpretación de los componentes.
En la siguiente gráfica se ilustra la calidad de la representación de las variables en las dos primeras dimensiones.
fviz_pca_var(compPrinc, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Interpretación del Gráfico de PCA:
Representa la relación entre las variables originales proyectadas en el espacio de los dos primeros componentes principales (Dim1 y Dim2). Vamos a analizarlo paso a paso.
Ejes del gráfico. El Eje X (Dim1) representa el primer componente principal (PC1) y el Eje Y (Dim2) representa el segundo componente principal (PC2). Cada eje indica el porcentaje de varianza total que explica. En conjunto, los dos primeros componentes capturan una proporción de la variabilidad total de los datos.
Longitud de las Flechas (Vectores). Cada flecha representa una variable original. La longitud de la flecha indica qué tan bien está representada la variable en el espacio de PC1 y PC2. Flechas largas indican que esas variables están bien representadas en los primeros dos componentes. Flechas cortas indican que la variable no está completamente explicada por PC1 y PC2 y puede necesitar más dimensiones para su interpretación.
Dirección de las Flechas. Las variables con vectores apuntando en la misma dirección están correlacionadas positivamente. Las variables con vectores opuestos tienen una correlación negativa. Las variables con vectores perpendiculares (ángulo de 90°) están débilmente correlacionadas o no tienen relación.
Color de las Flechas (cos2 - Calidad de Representación). El color indica el cos2, que mide la calidad de la representación de cada variable en el espacio de los componentes. Colores cálidos (rojo/naranja) representan variables bien explicadas por los primeros dos componentes (cos2 alto). Colores fríos (azul/verde) representan variables poco explicadas, lo que sugiere que necesitan más dimensiones para su correcta interpretación.
Relación con los Componentes Principales. Se identifica qué variables tienen las cargas más altas en cada dimensión para interpretar conceptualmente qué representa cada componente.
Biplot
El biplot combina la representación de las observaciones y las variables en el espacio de los componentes principales.
fviz_pca_biplot(compPrinc, repel = FALSE,
col.var = "#FC4E07",
col.ind = "#00AFBB",
alpha.ind = 0.1)
Contribución de las variables a cada componente
Los siguientes gráficos muestran qué variables contribuyen más a cada una de las primeras tres dimensiones. La línea roja discontinua representa la contribución esperada si todas las variables contribuyeran por igual.
fviz_contrib(compPrinc, choice = "var", axes = 1, top = 10)
fviz_contrib(compPrinc, choice = "var", axes = 2, top = 10)
fviz_contrib(compPrinc, choice = "var", axes = 3, top = 10)
Calidad de representación (cos2) por variable y componente
El siguiente gráfico muestra la calidad de la representación de cada variable en cada componente. Valores altos de cos2 indican que la variable está bien capturada por ese componente.
var <- get_pca_var(compPrinc)
corrplot(var$cos2, is.corr = FALSE)
Interpretación de las Componentes
Con base en los gráficos de contribución, las cargas factoriales y la calidad de representación, se interpretan los componentes retenidos.
compPrinc$rotation## PC1 PC2 PC3 PC4
## budget 0.342285418 -0.32776715 -0.2201714 -0.02606525
## revenue 0.321001751 -0.40425076 -0.3023611 -0.05327695
## runtime 0.332555927 0.25098687 0.1669475 0.01207898
## popularity 0.119777261 -0.07016405 -0.1535316 0.93630812
## voteAvg 0.318271825 0.30303692 0.1688037 0.09366696
## voteCount 0.343544478 -0.32460352 -0.2140084 -0.11546006
## genresAmount 0.262657432 0.18820240 0.2079680 0.16901057
## productionCoAmount 0.283443240 0.22677105 0.2381743 0.03425571
## productionCountriesAmount 0.092514975 0.46150814 -0.4868708 -0.09912764
## actorsAmount 0.387228908 -0.02185237 0.1302115 -0.16601710
## castWomenAmount 0.357354729 0.09358258 0.0796546 -0.17035392
## castMenAmount 0.001456695 0.39365410 -0.6115913 -0.03758186
## PC5 PC6 PC7 PC8
## budget 0.16753892 0.09270632 0.05719013 0.06290760
## revenue 0.16875832 0.04286622 -0.04405409 -0.09286877
## runtime -0.04609476 0.01213607 -0.36793408 -0.42507970
## popularity -0.27037547 0.01577473 0.04698612 0.02229141
## voteAvg 0.12416892 -0.17044979 -0.35470765 -0.31947089
## voteCount 0.09612636 0.05207196 -0.12226146 -0.11189998
## genresAmount 0.63853719 -0.38183294 0.45125657 0.16677717
## productionCoAmount 0.11961083 0.75030086 -0.09119477 0.45775242
## productionCountriesAmount -0.05977025 0.29956595 0.51531170 -0.39216164
## actorsAmount -0.38334628 -0.18861920 0.08907836 0.21279243
## castWomenAmount -0.51518274 -0.22868284 0.25727617 0.18675624
## castMenAmount 0.07475907 -0.26654588 -0.40597889 0.46940809
## PC9 PC10 PC11 PC12
## budget -0.235457891 -0.658723280 -0.200415842 3.909468e-01
## revenue 0.016687664 -0.006227415 0.469002032 -6.149115e-01
## runtime -0.673846303 0.148944964 0.055533221 2.677972e-02
## popularity 0.001511056 0.059568656 -0.029639711 1.966794e-05
## voteAvg 0.624699237 -0.327042681 0.001935764 -6.593754e-03
## voteCount 0.263254603 0.634849013 -0.219634689 3.968403e-01
## genresAmount -0.111751117 0.161638207 0.009567095 -9.782031e-03
## productionCoAmount 0.067550948 0.055082174 0.079050354 -3.709927e-02
## productionCountriesAmount 0.058193080 -0.004913406 -0.108414258 -6.138742e-02
## actorsAmount -0.015409311 0.000626347 -0.604399118 -4.514158e-01
## castWomenAmount 0.058179493 -0.003113240 0.551596145 3.189729e-01
## castMenAmount -0.081226106 0.033562862 0.003774840 6.414452e-03A partir de la matriz de rotación (loadings), se puede interpretar cada componente principal:
PC1 - Escala general de la película (38.2% de varianza). Este componente presenta cargas positivas en prácticamente todas las variables:
actorsAmount(0.39),castWomenAmount(0.36),voteCount(0.34),budget(0.34),runtime(0.33),revenue(0.32),voteAvg(0.32),productionCoAmount(0.28) ygenresAmount(0.26). Es un componente de tamaño o magnitud general: películas con valores altos en PC1 son producciones grandes en todos los sentidos (mayor presupuesto, más ingresos, elencos más numerosos, mayor duración, más votos y mejor calificación). Las variables con menor peso sonpopularity(0.12) ycastMenAmount(0.001), lo que indica que estas dos variables no se alinean con esta dimensión general. Es el patrón típico del primer componente en PCA, que captura la “escala” o “importancia” global del fenómeno.PC2 - Producción internacional/artística vs. éxito comercial (13.9% de varianza). Este componente contrasta dos perfiles de películas a través de cargas de signo opuesto. En el lado positivo:
productionCountriesAmount(0.46),castMenAmount(0.39),voteAvg(0.30),runtime(0.25) — variables que describen producciones internacionales, con mayor duración y mejor evaluadas cualitativamente. En el lado negativo:revenue(-0.40),budget(-0.33),voteCount(-0.32) — variables que representan el éxito comercial medido en dinero y volumen de votos. Este componente diferencia entre películas artísticas o de cine independiente/internacional (rodadas en múltiples países, bien evaluadas pero con menor presupuesto) y blockbusters comerciales (alto presupuesto, altos ingresos, muchos votos pero no necesariamente mejor calificación).PC3 - Estructura multinacional de producción (11.0% de varianza). Dominado por cargas negativas fuertes en
castMenAmount(-0.61) yproductionCountriesAmount(-0.49), y una carga negativa moderada enrevenue(-0.30). En el lado positivo, las cargas son más modestas:productionCoAmount(0.24),genresAmount(0.21). Este componente captura la dimensión de producción multinacional con elencos masculinos grandes en contraposición con producciones con más compañías y diversidad de géneros. La fuerte influencia decastMenAmountdebe interpretarse con cautela dado los valores extremos observados en esta variable (media desproporcionada respecto a la mediana).
Conclusiones
varianza <- summary(compPrinc)
varianza## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000Resumen de hallazgos
Viabilidad del PCA: Las pruebas previas confirmaron la conveniencia de aplicar PCA. El determinante de la matriz de correlación cercano a 0 (0.004625) indica multicolinealidad. El índice KMO de 0.82 (meritorio) y el rechazo contundente de la prueba de Bartlett (p-value = 0) respaldan la adecuación de los datos para el análisis factorial.
Dimensionalidad reducida: Según la regla de Kaiser, se retienen 3 componentes principales que explican el 63.1% de la varianza total. Si se requiriera mayor cobertura (80%), serían necesarios 6 componentes. Las 12 variables originales se resumen en 3 ejes decorrelacionados, facilitando el análisis.
Interpretabilidad de los componentes:
- PC1 (38.2%) — Escala general de la película: captura la magnitud global de una producción (presupuesto, ingresos, elenco, duración, votos, calificación). Diferencia entre grandes producciones y películas pequeñas.
- PC2 (13.9%) — Producción artística/internacional vs. comercial: contrasta películas rodadas en múltiples países con buenas calificaciones pero menor presupuesto (perfil de cine independiente/artístico) contra blockbusters comerciales de alto presupuesto y altos ingresos.
- PC3 (11.0%) — Estructura multinacional de producción: captura la relación entre la cantidad de países de producción, la composición masculina del elenco y la diversidad de géneros/compañías.
Observaciones sobre la calidad de los datos: La variable
castMenAmountpresenta valores extremos (media desproporcionada respecto a la mediana, con un máximo de 922,017) que afectan su comportamiento en el PCA. Esto se refleja en su MSA bajo (0.50) y su carga casi nula en PC1. Para futuros análisis, se recomienda investigar y tratar estos outliers antes de aplicar PCA.Utilidad para modelos predictivos: Al utilizar los componentes principales en lugar de las 12 variables originales, se reduce la dimensionalidad, se eliminan problemas de multicolinealidad y se facilita la construcción de modelos de predicción futuros con variables decorrelacionadas.
Recomendaciones para CineVision Studios:
- Perfilamiento de películas: Los tres componentes permiten ubicar cada película en un espacio tridimensional interpretable (escala general, perfil comercial vs. artístico, estructura de producción).
- Segmentación estratégica: CineVision Studios puede segmentar su catálogo según estos ejes para identificar nichos de mercado no explotados, por ejemplo, películas con alto potencial artístico (PC2 alto) pero baja visibilidad comercial.
- Modelos predictivos: Utilizar los scores de los componentes como variables de entrada para modelos de predicción de ingresos o popularidad, aprovechando que están decorrelacionados.
- Limpieza de datos: Antes de aplicar modelos
avanzados, se recomienda revisar la variable
castMenAmountyproductionCountriesAmountpara corregir posibles errores de registro.
4.1
Justificación de la Selección: UMAP
Para esta última fase de la consultoría, se evaluaron las cuatro opciones propuestas (SVD, t-SNE, UMAP, ICA). Se descartó SVD por ser el motor matemático subyacente del PCA (ya realizado, resultaría redundante) e ICA porque las variables cinematográficas (presupuesto, ingresos, popularidad) están altamente entrelazadas y no provienen de “fuentes independientes” puras.
Entre t-SNE y UMAP, se seleccionó UMAP. A diferencia del PCA, que es lineal y puede superponer grupos en su proyección 2D, UMAP es un algoritmo de reducción de dimensionalidad no lineal excelente para separar visualmente “islas” de datos complejos. Se prefirió por encima de t-SNE debido a su superior eficiencia computacional y menor consumo de memoria RAM, lo cual es vital dada la alta carga de procesamiento que exige este volumen de datos. Esta técnica permitirá a CineVision Studios tener un mapa visual topológico claro para validar si los 4 perfiles comerciales descubiertos en el clustering realmente forman agrupaciones separadas y naturales.
library(umap)
library(ggplot2)
library(dplyr)
cat("Ejecutando algoritmo UMAP...\n")## Ejecutando algoritmo UMAP...# Configuración de UMAP
umap_config <- umap.defaults
umap_config$random_state <- 666
umap_res <- umap(movies_sample_scaled, config = umap_config)
# dataframe combinando las coordenadas UMAP y los Clústeres de K-Medias
umap_data <- data.frame(
UMAP1 = umap_res$layout[, 1],
UMAP2 = umap_res$layout[, 2],
Cluster_KMeans = movies_sample_cluster$Cluster_KMeans
)
# grafico de dispersión no lineal
grafica_umap <- ggplot(umap_data, aes(x = UMAP1, y = UMAP2, color = Cluster_KMeans)) +
geom_point(alpha = 0.7, size = 2.5) +
theme_minimal() +
labs(title = "Proyección UMAP: Visualización Topológica de Películas",
subtitle = "Mapeo no lineal coloreado según los 4 perfiles comerciales (K-Medias)",
x = "UMAP Dimensión 1",
y = "UMAP Dimensión 2",
color = "Clúster") +
theme(plot.title = element_text(face = "bold"),
legend.position = "right")
print(grafica_umap)
#
4.2 El mapa visual generado por el algoritmo UMAP confirma claramente
que los cuatro grupos de películas descubiertos antes están bien
separados en la realidad. Se observa un núcleo principal que agrupa al
cine comercial exitoso, el cual está muy alejado de las producciones
amateur o cortometrajes que aparecen dispersos por su gran variedad de
formatos. Por otro lado, las películas épicas y el cine independiente de
nicho forman sus propias islas totalmente aisladas del resto. Para
CineVision Studios, este gráfico funciona como un radar de riesgo muy
útil para predecir de forma visual a qué modelo de negocio pertenecerá
cualquier nuevo proyecto.